Whiteline: delta/whiteline CD Series - delta.iso/progtool/modula2/module/liste.mod

Text File | 1995-11-25 | 4KB | 174 lines

IMPLEMENTATION MODULE  Liste;

FROM SYSTEM IMPORT TSIZE;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;

TYPE List               = POINTER TO ListHeader;
     ListElementPointer = POINTER TO ListElement;
     ListHeader         = RECORD
                             current,
                             first,last : ListElementPointer;
                          END ;
     ListElement        = RECORD
                             next,prev     : ListElementPointer;
                             value         :ARRAY[0..9] OF INTEGER;
                          END ;

PROCEDURE MakeList(VAR L:List);
BEGIN
   ALLOCATE(L,TSIZE(ListHeader));
   L^.first:=NIL;
   L^.last:=NIL;
   L^.current:=NIL;
END MakeList;

PROCEDURE KillList(VAR L:List);
VAR p,q:ListElementPointer;
BEGIN
    p:=L^.first;
    WHILE (p#NIL) DO
      q:=p;
      p:=p^.next;
      DEALLOCATE(q);
    END(*WHILE*);
    DEALLOCATE(L);
    L:=NIL
END KillList;

PROCEDURE First(VAR L:List);
BEGIN
    L^.current:=L^.first;
END First;

PROCEDURE Last(VAR L:List);
BEGIN
    L^.current:=L^.last;
END Last;

PROCEDURE Next(VAR L:List);
BEGIN
   IF (~Empty(L) AND (L^.current^.next # NIL))THEN
      L^.current:=L^.current^.next;
   END(*IF*);
END Next;

PROCEDURE Prev(VAR L:List);
BEGIN
   IF (~Empty(L) AND (L^.current^.prev # NIL))THEN
      L^.current:=L^.current^.prev;
   END(*IF*);
END Prev;

PROCEDURE Empty(VAR L:List):BOOLEAN;
BEGIN
   RETURN L^.first=NIL
END Empty;

PROCEDURE AtFirst(VAR L:List):BOOLEAN;
BEGIN
   RETURN L^.current=L^.first
END AtFirst;

PROCEDURE AtLast(VAR L:List):BOOLEAN;
BEGIN
   RETURN L^.current=L^.last
END AtLast;

PROCEDURE GetValue(VAR L:List;VAR Value :ARRAY OF INTEGER):BOOLEAN;
VAR i:INTEGER;
BEGIN
   IF ~Empty(L) THEN
     FOR i:=0 TO HIGH(L^.current^.value) DO
         Value[i]:=L^.current^.value[i];
     END(*FOR*);
     RETURN TRUE
   ELSE
     RETURN FALSE
   END(*IF*);
END GetValue;

PROCEDURE SetValue(VAR L:List;Value :ARRAY  OF INTEGER);
VAR  i:INTEGER;
BEGIN
   IF ~Empty(L) THEN
     FOR i:=0 TO HIGH(L^.current^.value) DO
         L^.current^.value[i]:=Value[i];
     END(*FOR*);
   END(*IF*);
END SetValue;

PROCEDURE EnterElement(VAR L:List);
VAR p,q :ListElementPointer;
BEGIN
   ALLOCATE(p,TSIZE(ListElement));
   IF Empty(L) THEN
         L^.first:=p;
         L^.last:=p;
         p^.next:=NIL;
         p^.prev:=NIL;
   ELSIF AtFirst(L) THEN
         p^.next:=L^.first;
         L^.first:=p;
         p^.prev:=NIL;
         L^.current^.prev:=p;
   ELSE
         p^.next:=L^.current;
         p^.prev:=L^.current^.prev;
         q:=L^.current^.prev;
         q^.next:=p;
         L^.current^.prev:=p;
  END(*IF*);
  L^.current:=p;
END EnterElement;

PROCEDURE AppendElement(VAR L:List);
VAR p,q :ListElementPointer;
BEGIN
   ALLOCATE(p,TSIZE(ListElement));
   IF Empty(L) THEN
         L^.first:=p;
         L^.last:=p;
         p^.next:=NIL;
         p^.prev:=NIL;
   ELSIF AtLast(L) THEN
         p^.prev:=L^.last;
         L^.last:=p;
         p^.next:=NIL;
         L^.current^.next:=p;
   ELSE
         p^.next:=L^.current^.next;
         p^.prev:=L^.current;
         q:=L^.current^.next;
         q^.prev:=p;
         L^.current^.next:=p;
  END(*IF*);
  L^.current:=p;
END AppendElement;

PROCEDURE RemoveElement(VAR L:List);
VAR p,q :ListElementPointer;
BEGIN
   IF ~Empty(L) THEN
   p:=L^.current;
   IF (AtFirst(L) AND AtLast(L)) THEN
       L^.first:=NIL;
       L^.last:=NIL;
       L^.current:=NIL;
   ELSIF AtFirst(L) THEN
       L^.first:=L^.current^.next;
       L^.first^.prev:=NIL;
       L^.current:=L^.current^.next;
   ELSIF AtLast(L) THEN
       L^.last:=L^.current^.prev;
       L^.last^.next:=NIL;
       L^.current:=L^.current^.prev;
   ELSE
       p^.prev^.next:=p^.next;
       p^.next^.prev:=p^.prev;
       L^.current:=L^.current^.next;
   END(*IF*);
   DEALLOCATE(p);
   END(*IF*);
END RemoveElement;
END Liste.